Financial Burn Down Scenarios

Intro

Exploration of some different scenarios for financial burndown based on various assumptions around present value, annual expenditures, annual returns.

References

• Time value of money calculations in R - no pkg

Inputs & Output

Inputs needed:

• starting balance
• annual drawdown
• return on balance
• number of years of drawdown period

Output is remaining balance at end of period.

Single Scenario

## loop through each year, new calc based on balance at end of each year to get year-by-year schedule
startbal <- -600000
draw <- 60000
return <- 0.04
yrs <- 10

start_bal <- startbal
sched_all_s <- data.frame()
for(y in 1:yrs){
  remain <- fv(r=return, n=1, pv=start_bal, pmt=draw, type=0)
  sched <- data.frame('year'=y,
                      'balance'=remain)
  sched_all_s <- bind_rows(sched_all_s, sched)
  start_bal <- remain*-1
}

• Start: $600,000
• Draw: $60,000 / yr
• Return rate: 4%
• Years: 10

At end of 10 years, you will have $167,780 left.

sched_all_s %>% ggplot(aes(x=as.factor(year), y=balance))+geom_line(group=1)+
  scale_y_continuous(labels=comma)+
  labs(title=paste0("$",format(remain, big.mark=",", digits=0), " left after ", yrs, " years."),
       y="", x="year from start")

Multiple Scenarios

## loop through each year, new calc based on balance at end of each year to get year-by-year schedule
scenarios <- tribble(
  ~startbal, ~draw, ~return, ~yrs,
  -600000, 60000, 0.04, 20,
  -700000, 60000, 0.03, 20,
  -700000, 60000, 0.02, 20,
  -800000, 60000, 0.02, 20,
  -800000, 60000, 0.03, 20,
  -1000000, 70000, 0.03, 20,
  -1000000, 60000, 0.04, 20,
  -800000, 60000, 0.04, 20
)
scenarios <- scenarios %>% mutate(
  scenario=paste0(as.character(startbal/1000*-1),"k-",as.character(draw/1000),"k-",as.character(return*100),"%-", as.character(yrs),"y")
)

sched_all_scenario <- data.frame()
for(s in 1:nrow(scenarios)){
  scen <- scenarios$scenario[s]
  start_bal <- scenarios$startbal[s]
  sched_all <- data.frame()
  for(y in 1:scenarios$yrs[s]){
    remain <- fv(r=scenarios$return[s], n=1, pv=start_bal, pmt=scenarios$draw[s], type=0)
    sched <- data.frame('scenario'=scen,
                        'year'=y,
                        'balance'=remain)
    sched_all <- bind_rows(sched_all, sched)
    start_bal <- remain*-1
  }
  sched_all_scenario <- bind_rows(sched_all_scenario, sched_all)
}

pbar <- sched_all_scenario %>% ggplot(aes(x=year, y=balance, fill=scenario))+geom_col(position = position_dodge())+
  scale_y_continuous(labels=comma)+
  labs(title=paste0("How much left after ", max(scenarios$yrs), " years in different scenarios"),
       y="", x="year from start")

ggplotly(pbar)

pline <- sched_all_scenario %>% ggplot(aes(x=year, y=balance, color=scenario))+geom_line()+
  geom_hline(yintercept=0)+
  scale_y_continuous(labels=comma)+
  labs(title=paste0("How much left after ", yrs, " years in different scenarios"),
       y="", x="year from start")

ggplotly(pline)

Simulations

Setup and Run Simulations

## number of simulations
nsims <- 100
## number of years to simulate
yrs <- 20
## parameters for starting, return, draw - exact numbers determined in loop
## min and max starting balance
start_min <- 600000
start_max <- 900000
## return rate 
r_mean <- 0.03
r_sd <- 0.07
r_max <- 0.20
## draw 
draw_min <- 50000
draw_max <- 75000

sim_all <- data.frame()

for(s in 1:nsims){
  sim <- s
  bal_start <- round(runif(n=1, min=start_min, max=start_max),0)
  bal_start_set <- bal_start
  bal_start_no_draw <- bal_start
  sim_sched <- data.frame()
  for(y in 1:yrs){
    rrate <- round(min(rnorm(n=1, mean=r_mean, sd=r_sd), r_max), 3)
    draw <- round(runif(n=1, min=draw_min, max=draw_max),0)
    return <- round(bal_start*rrate, 0)
    bal_remain <- ifelse(bal_start>0,bal_start+return-draw,bal_start-draw)
    bal_no_draw <- round(bal_start_no_draw*(1+rrate),0)
    sim_yr <- data.frame('sim'=sim,
                        'year'=y,
                        'start'=bal_start,
                        'rrate'=rrate,
                        'return'=return,
                        'draw'=draw,
                        'balance'=bal_remain,
                        'bal_no_draw'=bal_no_draw)
    sim_sched <- bind_rows(sim_sched, sim_yr)
    bal_start <- bal_remain
    bal_start_no_draw <- bal_no_draw
  }
  sim_all<- bind_rows(sim_all, sim_sched)
}
sim_all$sim <- as.factor(sim_all$sim)

• Number of simulations: 100
• Number of years: 20
• Starting balance: 600000 to 900000 (uniform dist.)
• Rate of return: average 0.03 ave, 0.07 std dev (normal dist. with max 0.2)
• Annual draw: 50000 to 75000 (uniform dist.)

Visualize Progress Over Time

psim <- sim_all %>% ggplot(aes(x=year, y=balance, color=sim))+geom_line()+
  geom_hline(yintercept=0)+
  scale_y_continuous(labels=comma)+
  theme(legend.position = 'none')+
  labs(title=paste0("How much left after ", yrs, " years in different simulations"),
       y="", x="year from start")

ggplotly(psim)

Summarize

Distribution of End Balances

chart_title <- "Distribution of End Balances"
sim_all %>% ggplot(aes(x=balance))+geom_histogram()+
  labs(title=chart_title)

What Really Counts: under water or not?

sim_all <- sim_all %>% filter(year==20) %>% mutate(
  pos=ifelse(balance>0,"money","no money")
)

sim_all %>% ggplot(aes(x=pos))+geom_bar()+
  labs("How likely to run out of money???")

sim_neg <- sim_all %>% filter(balance<=0)
sim_neg_yr <- sim_neg %>% group_by(sim) %>% summarize(yr=min(year))

sim_neg_yr %>% ggplot(aes(x=yr))+geom_bar()+
  labs(title="Distribution of Years when Balance = $0")

For those simulations that go below $0 with end balance.

chart_title <- "Distribution of Returns in Sims"
hist1 <- sim_all %>% ggplot(aes(x=rrate))+geom_histogram()+
  geom_vline(xintercept=mean(sim_all$rrate), linetype='dotted')+
  scale_y_continuous(expand=expansion(add=c(0,1)))+
  scale_x_continuous(labels=percent)+
  labs(title=chart_title)

mrate_all <- mean(sim_all$rrate)
sdrate_all <- sd(sim_all$rrate)

## calc returns when draw downs excluded
sim_rr <- sim_all %>% group_by(sim) %>% summarize(start_bal=first(start),
                                                  end_bal=last(bal_no_draw),
                                                  yrs=max(year)) %>%
  mutate(ttl_return=end_bal/start_bal-1,
         ttl_return_ave=ttl_return/yrs)

chart_title <- "Distribution of Real Returns in Sims (no draw)"
hist2 <- sim_rr %>% ggplot(aes(x=ttl_return_ave))+geom_histogram()+
  geom_vline(xintercept=mean(sim_rr$ttl_return_ave), linetype='dotted')+
  scale_y_continuous(expand=expansion(add=c(0,1)))+
  scale_x_continuous(labels=percent)+
  labs(title=chart_title)

grid.arrange(hist1, hist2, nrow=1)

• Mean rate of return (straight ave): 0.03064

• Std dev rate of return (straight sd): 0.0669992

• Mean total rate of return, no draws: -0.0598149

• Std dev rate of return, no draws: 1.919092

chart_title <- "Returns over time"
sim_all %>% ggplot(aes(x=as.factor(year), y=return))+geom_boxplot()+
  geom_hline(yintercept = 0)+
  scale_y_continuous(labels=comma)+
  labs(title=chart_title)

chart_title <- "Draws over time"
sim_all %>% ggplot(aes(x=as.factor(year), y=draw))+geom_boxplot()+
  geom_hline(yintercept=mean(sim_all$draw), linetype='dashed')+
  scale_y_continuous(labels=comma)+
  labs(title=chart_title, x='year from start')

Evaluate Positive Outcomes

Identify Positive Outcomes

## identify sims where balance > 0 at year 20
sim_pos <- sim_all[sim_all$year==20 & sim_all$balance>0,]
sim_pos_rate <- nrow(sim_pos)/nsims
## filter full list for positive sims only
sim_pos_filter <- sim_pos %>% select(sim)
sim_pos_all <- left_join(sim_pos_filter, sim_all, by='sim')

## summarize individual sims
sim_pos_ind_smry <- sim_pos_all %>% group_by(sim) %>% summarize(
  start_bal=first(start),
  ave_rate=round(mean(rrate),3),
  ave_draw=round(mean(draw),0),
  end_bal=last(balance)
)

chart_title <- paste0("Ending Balance after ", yrs," yrs for positive sims")
sim_pos %>% ggplot(aes(x=reorder(sim, -balance), y=balance))+geom_col(position=position_dodge())+
  scale_y_continuous(labels=comma, expand=expansion(mult=c(0,0.05)))+
  labs(title=chart_title, x='sim')

Overall Sim Summary

sim_pos_smry <- sim_pos_ind_smry %>% summarize(
  ave_start=mean(start_bal),
  ave_rate=mean(ave_rate),
  ave_draw=mean(ave_draw),
  end_bal=mean(end_bal)
)
sim_pos_smry

## # A tibble: 1 x 4
##   ave_start ave_rate ave_draw end_bal
##       <dbl>    <dbl>    <dbl>   <dbl>
## 1   278460.   0.0503   60336.  233231

Individual Pos Sim Summary

sim_pos_ind_smry 

## # A tibble: 7 x 5
##   sim   start_bal ave_rate ave_draw end_bal
##   <fct>     <dbl>    <dbl>    <dbl>   <dbl>
## 1 6        188769   -0.042    73102  107739
## 2 16       870910    0.063    51689  874088
## 3 22       153874   -0.016    61432   89980
## 4 38       197971    0.052    59185  149080
## 5 57       141447    0.198    60752  108702
## 6 78       281509    0.071    52122  249374
## 7 99       114738    0.026    64067   53654

Detailed Table

## DT to add table of all rows for each positive sim for inspection
datatable(sim_pos_all)

What is distribution in returns within sims?

chart_title <- 'Distributions in Annual Returns across positive sims'
sim_pos_all %>% ggplot(aes(x=sim, y=rrate))+geom_boxplot()+
  geom_hline(yintercept = 0)+
  labs(title=chart_title)

Is there correlation between starting balance & returns?

Do sims in the positive set have both high starting AND high returns?

sim_pos_ind_smry %>% ggplot(aes(x=start_bal, y=ave_rate))+geom_point()